COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 A ACWPRV PDLEN IMPSRV S%Clos S%List S%SynS S%SyRP S%SyRA S%Estb S%Fin1 S%Fin2 S%Clsn S%TimW S%ClsW S%LAck DEVNAM DEVSER STATE GTIMER TTYLIN IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP BADDDB CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2
C00011 ENDMK
C⊗;
;⊗ A ACWPRV PDLEN IMPSRV S%Clos S%List S%SynS S%SyRP S%SyRA S%Estb S%Fin1 S%Fin2 S%Clsn S%TimW S%ClsW S%LAck DEVNAM DEVSER STATE GTIMER TTYLIN IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP BADDDB CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2

	TITLE CLRIMP

;Program to clear away hanging IMP DDBs "cleanly" by changing the state
;to Time Wait and setting a timer.  This ensures that the DDBFls routine
;will be called and release all free storage pointed to by this DDB.

;There are two modes.  In "automatic" mode, the program clears all DDBs
;in Fin2 and error states.  In "manual" mode, the program prompts for
;each DDB in these states plus Fin1, Clsn, ClsW and LAck, and DDBs
;awaiting servers, and the user confirms which ones he wants to clear.

A←←1 ↔ B←←2 ↔ C←←3 ↔ DDB←←4 ↔ P←←17

ACWPRV←←40		;LH priv bit
PDLEN←←20
IMPSRV←←1		;TTYLIN(DDB) flag for DDB awaiting server

;Names of TCP states.  State less than 0 indicates ICMP error received.
S%Clos←←=0		;Closed
S%List←←=1		;Listen
S%SynS←←=2		;SYN sent
S%SyRP←←=3		;SYN received, passive
S%SyRA←←=4		;SYN received, active (from S%SynS)
S%Estb←←=5		;Established
S%Fin1←←=6		;FIN wait 1
S%Fin2←←=7		;FIN wait 2
S%Clsn←←=8		;Closing
S%TimW←←=9		;Time wait
S%ClsW←←=10		;Close wait
S%LAck←←=11		;Last ACK

;IMP DDB words, with AC field set for indirect access
DEVNAM:	0(DDB)
DEVSER:	3(DDB)
STATE:	(DDB)			;To be filled in with .SYMLed value
GTIMER:	(DDB)			;To be filled in with .SYMLed value
TTYLIN:	(DDB)			;To be filled in with .SYMLed value

;Other storage
IMPDDB:	0			;Address of model IMP DDB
SYSTOP:	0			;Start of system free storage
SYSREL:	0			;Relocation for system core
DDBSAV:	0			;Address of current DDB
CONFRM:	0			;Whether to confirm each DDB
NUMBAD:	0			;Number of bad DDBs found
NUMCLR:	0			;Number cleared
PDL:	BLOCK PDLEN

CLRIMP:	RESET
	SETZM NUMBAD
	SETZM NUMCLR
	MOVE P,[IOWD PDLEN,PDL]
	MOVSI A,1
	GETPRV A,		;Get passive privs
	TLNN A,ACWPRV		;Can this guy write core?
	 JRST [ OUTSTR [ASCIZ/Sorry, only wizards can run this program./]
		EXIT]
	MOVSI A,ACWPRV
	SETPRV A,		;Enable
	MOVEI A,[RADIX50 0,IMPDDB ↔ 0]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for IMPDDB./]
		EXIT]
	MOVEM A,IMPDDB
	MOVEI A,[RADIX50 0,STATE ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for STATE./]
		EXIT]
	HRRM A,STATE
	MOVEI A,[RADIX50 0,GTIMER ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for GTIMER./]
		EXIT]
	HRRM A,GTIMER
	MOVEI A,[RADIX50 0,TTYLIN ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for TTYLIN./]
		EXIT]
	HRRM A,TTYLIN
	MOVEI A,265
	PEEK A,			;Get SYSTOP
	PEEK A,
	TRZ A,1777		;Make sure it's a 1K boundary
	CAILE A,400000		;Not beyond 400000, though
	 MOVEI A,400000
	MOVEM A,SYSTOP
	MOVEI B,400000		;Compute relocation for later offsets
	SUB B,A
	MOVEM B,SYSREL
	MOVE B,A
	ADDI B,377776		;Get as much as possible, writeable
	HRL A,B
	SETPR2 A,		;Map system into upper segment
	 JRST [ OUTSTR [ASCIZ/SETPR2 lost./]
		EXIT]
	SETOM CONFRM		;Assume yes
	OUTSTR [ASCIZ/Do you want to confirm each DDB being cleared? /]
	PUSHJ P,YESNO
	SETZM CONFRM		;No

	;Set up to loop through IMP DDBs.
	MOVE A,IMPDDB
	ADD A,DEVSER
	HRRZ A,A
	PEEK A,
	HLRZ DDB,A		;Address of first IMP DDB
LOOP:	MOVEM DDB,DDBSAV	;Save before relocating
	ADD DDB,SYSREL		;Relocate to upper segment
	HLRZ A,@DEVNAM		;Get device name
	CAIE A,'IMP'		;Is it an IMP?
	 JRST ALLDON		;No
	;First check conditions for non-confirm mode.
	MOVEI C,[ASCIZ/ in error state/]
	SKIPGE A,@STATE		;Get connection's TCP state, skip unless error
	JRST BADDDB
	MOVEI C,[ASCIZ/ in state Fin2/]
	CAIN A,S%FIN2
	JRST BADDDB
	SKIPN CONFRM		;In manual mode?
	JRST NXTIMP		;No, move on to next DDB
	MOVEI C,[ASCIZ/ in state Fin1/]
	CAIN A,S%FIN1
	JRST BADDDB
	MOVEI C,[ASCIZ/ in state Clsn/]
	CAIN A,S%CLSN
	JRST BADDDB
	MOVEI C,[ASCIZ/ in state ClsW/]
	CAIN A,S%CLSW
	JRST BADDDB
	MOVEI C,[ASCIZ/ in state LAck/]
	CAIN A,S%LACK
	JRST BADDDB
	MOVE A,@TTYLIN		;Get TTYLIN word from DDB
	MOVEI C,[ASCIZ/ awaiting server/]
	TLNE A,IMPSRV		;Awaiting server?
	JRST BADDDB		;Yes
	JRST NXTIMP		;No, move on to next DDB

BADDDB:	AOS NUMBAD		;Count them
	SKIPN CONFRM		;Does he want to confirm?
	 JRST CLRONE		;No
	OUTSTR [ASCIZ/IMP DDB at /]
	MOVE A,DDBSAV
	PUSHJ P,OCTOUT		;Clobbers A and B
	OUTSTR (C)		;Reason for DDB
	OUTSTR [ASCIZ/.  Clear it? /]
	PUSHJ P,YESNO
	 JRST NXTIMP		;No
CLRONE:	AOS NUMCLR		;Count number cleared
	MOVEI A,1		;Set timer
	MOVEM A,@GTIMER
	MOVEI A,S%TIMW		;Set new state
	MOVEM A,@STATE
NXTIMP:	HLRZ DDB,@DEVSER	;Get next DDB
	CAML DDB,SYSTOP		;Make sure it's in free storage
	 JRST LOOP
ALLDON:	MOVE A,NUMBAD
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ bad DDBs found, /]
	MOVE A,NUMCLR
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ cleared./]
	EXIT

OCTOUT:	IDIVI A,10
	PUSH P,B
	JUMPE A,OCTOU1
	PUSHJ P,OCTOUT
OCTOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

DECOUT:	IDIVI A,=10
	PUSH P,B
	JUMPE A,DECOU1
	PUSHJ P,DECOUT
DECOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

;Get Yes-or-no response; skip if Yes.
YESNO:	INCHRW A
	CAIN A,15		;<cr>?
	 JRST [ INCHRW A	;Yes, eat <lf>
		JRST YESNO2]
	CAIE A,"Y"
	CAIN A,"y"
	CAIA
	JRST YESNO1
	OUTSTR [ASCIZ/es.
/]
CPOPJ1:	AOS (P)
CPOPJ:	POPJ P,

YESNO1:	CAIE A,"N"
	CAIN A,"n"
	CAIA
	JRST YESNO2
	OUTSTR [ASCIZ/o.
/]
	POPJ P,

YESNO2:	OUTSTR [ASCIZ/
Please type Y or N: /]
	JRST YESNO

	END CLRIMP